perm filename GATHER.SAI[8,ALS] blob
sn#038321 filedate 1973-04-30 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00002 PAGES
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00002 00002 BEGIN "SAY"
00500 00007 ENDMK
00600 ⊗;
00100 BEGIN "SAY"
00200 DEFINE ⊂="COMMENT"; ⊂ 6/30/72 Runs SIG from FIX output;
00300 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00400 REQUIRE "SAVE[8,ALS]" LOAD_MODULE;
00500 REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00600 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00700 INTEGER ARRAY LFILE[0:'177];
00800 INTERNAL INTEGER ARRAY INDATA[0:768];
00900 INTERNAL INTEGER H,I,J,K,L,M,N,P,NF;
01000 INTERNAL INTEGER FLAG,TFLAG,UPCNT;
01100 INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,INFLAG;
01200 INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,BRK;
01300 STRING PREHINT;
01400 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5;
01500 STRING READ1,FILEL,FILEI,TFILE,TFILEI,FILLST;
01600 LABEL START,ZZZZ,ZZZ,ZZ;
01700 DEFINE ⊂="COMMENT",CR="'15",LF="'12",TB="'11";
01800 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
01900 BOOLEAN ER;
02000
02100 INTEGER EOFB,RL;
02200 INTERNAL INTEGER STX,STXX;
02300 STRING FILSTR,SNAMES,SNAME;
02400
02500 INTEGER PROCEDURE UPDATE;
02600 BEGIN "UPDATE"
02700
02800 COMMENT This procedure both smooths and spreads the output values
02900 as reported in the last 3 bits in the values stored in TABLES.
03000 This output is reported in addition to the actual ratio output
03100 which is now moved over 3 bits.
03200 This routine works only for P tables;
03300
03400 COMMENT SIG must be fixed before this can be used;
03500
03600 INTEGER I,J,K,L,M,N,P,Q,Z;
03700 INTEGER GOOD,BAD,SUM,PLACE;
03800 INTEGER ARRAY PAD[0:64];
03900
04000
04100 FOR I←STXX+10 STEP 74 UNTIL STX-64 DO BEGIN
04300 P←0;
04325
04400 FOR J←0 STEP 1 UNTIL 7 DO
04500 FOR K←0 STEP 1 UNTIL 7 DO BEGIN
04600 N←J*8+K;
04700 GOOD←POINT(15,TABLES[I+N],29);
04800 L←LDB(GOOD);
04900 BAD←POINT(15,TABLES[I+N],14);
05000 Z←L+LDB(BAD);
05120 PLACE←POINT(3,TABLES[I-9],5);
05130 IF PLACE=2 THEN BEGIN
05140
05200 L←L LSH 3; Z←Z LSH 3;
05300
05400 IF J>0 THEN BEGIN
05500 GOOD←POINT(15,TABLES[I+N-8],29); L←L+LDB(GOOD);
05600 BAD←POINT(15,TABLES[I+N-8],14); Z←Z+LDB(BAD)+LDB(GOOD); END;
05700
05800 IF J<7 THEN BEGIN
05900 GOOD←POINT(15,TABLES[I+N+8],29); L←L+LDB(GOOD);
06000 BAD←POINT(15,TABLES[I+N+8],14); Z←Z+LDB(BAD)+LDB(GOOD); END;
06100
06200 IF K>0 THEN BEGIN
06300 GOOD←POINT(15,TABLES[I+N-1],29); L←L+LDB(GOOD);
06400 BAD←POINT(15,TABLES[I+N-1],14); Z←Z+LDB(BAD)+LDB(GOOD); END;
06500
06600 IF K<7 THEN BEGIN
06700 GOOD←POINT(15,TABLES[I+N+1],29); L←L+LDB(GOOD);
06800 BAD←POINT(15,TABLES[I+N+1],14); Z←Z+LDB(BAD)+LDB(GOOD); END;
06900
06950 END;
06960
07000 M←(L LSH 8)/Z;
07100
07125 Q←Z LSH -3;
07150 COMMENT IF M≥64 THEN IF M<192 THEN P←P+Q;
07175 P←P+Q;
07200 PAD[N]←(M LSH 27)+(Q LSH 6)+N;
07300 M←M LSH -5; IF M>7 THEN M←7;
07400 SUM←POINT(30,TABLES[I+N],29);
07500 TABLES[I+N]←(LDB(SUM) LSH 6)+(M LSH 3);
07600 END;
07700
07800 FOR J←0 STEP 1 UNTIL 62 DO
07900 FOR K←J+1 STEP 1 UNTIL 63 DO
08000 IF (PAD[J]>PAD[K]) THEN BEGIN
08100 Z←PAD[J]; PAD[J]←PAD[K]; PAD[K]←Z; END;
08200
08300 K←P/8; L←0; M←0;
08400
08500 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
08600 PLACE←POINT(6,PAD[J],35);
08700 N←LDB(PLACE);
08800 SUM←POINT(33,TABLES[I+N],32);
08810 P←POINT(8,PAD[J],8);
08820 COMMENT IF P<64 THEN TABLES[I+N]←(LDB(SUM) LSH 3)
08830 COMMENT ELSE IF P≥192 THEN TABLES[I+N]←(LDB(SUM) LSH 3)+7
08840 COMMENT ELSE BEGIN
08900 TABLES[I+N]←(LDB(SUM) LSH 3)+L;
09000 SUM←POINT(20,PAD[J],29);
09100 M←M+LDB(SUM);
09200 IF M>K THEN BEGIN
09300 M←M-K; L←L+1; IF L≥8 THEN L←7; END;
09310 COMMENT END;
09400 END;
09500
09600 END;
09700
09800 END "UPDATE";
09900
10000 STRING PROCEDURE HEADER;
10100 BEGIN "HEADER"
10200 STRING H1,H2; INTEGER I,J,K;
10300 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1; RETURN(PREHINT) END
10400 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
10500 I←LFILE[HINDEX]; K←LDB(POINT(7,I,30)); J←SEGC-K;
10600 IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←99; RETURN(PREHINT) END;
10700 IF J ≥ 0 THEN BEGIN "LATCH" H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
10800 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
10900 IF EQU(H1,H2) THEN BEGIN PREHINT←H1; HCOUNT←LDB(POINT(5,I,35));
11000 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1; RETURN(PREHINT); DONE END
11100 ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(5,I,35));
11200 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
11300 END "LATCH";
11400 PREHINT←"NU"; RETURN(PREHINT); END "XX";
11500 END "HEADER";
11600
11700 STDBRK(1);
11800 SETBREAK(14,"∃",NULL,"INS");
11900
12000 FILEL←"LIST1.L0";
12100 FILEI←"TOO1.DAT[1,THO]"; M←8; INFLAG←0;
12200 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5;
12300 TABIN(INTOT);
12400
12500 FILSTR←STRIN("Ripple learn break-point list (STFILE.TMP) =");
12600 IF FILSTR="" THEN FILSTR←"STFILE.TMP";
12700 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFB);
12800 LOOKUP(CHAN5,FILSTR,ER);
12900 WHILE ER DO BEGIN OUTSTR(CRLF&"Can not find "&FILSTR&
13000 " File = ");
13100 LOOKUP(CHAN5,FILSTR←INCHWL,ER); END;
13200 SNAMES←INPUT(CHAN5,14);
13300 SNAME←SCAN(SNAMES,1,J);
13400 FOR I←19 STEP 1 UNTIL 125 DO BEGIN
13500 IF LIST[I]=CVSIX(SNAME) THEN DONE;
13600 END;
13700 OUTSTR("I="&CVS(I)&" SNAME="&CVXSTR(LIST[I])&CRLF);
13800 STX←I*74; EOFB←0;
13900
14000 FILEL←STRIN("Data file list (LNFILE.TMP) = ");
14100 IF FILEL="" THEN FILEL←"LNFILE.TMP";
14200 START:
14300 WHILE EOFB=0 DO BEGIN "RIPPLE"
14400 IF SNAME="END" THEN DONE;
14500 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFA);
14600 LOOKUP(CHAN5,FILEL,ER); WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&
14700 " File = "); LOOKUP(CHAN5,FILEL←INCHWL,ER); END; EOFA←0;
14800 M←8; N←2↑M; NF←2*N;
14900
15000 FILLST←INPUT(CHAN5,14); EOFA←0;
15100
15200 OUTSTR(CRLF&"Ripple learn starting with "&SNAME&" up to ");
15300 STXX←STX; SNAME←SCAN(SNAMES,1,J);
15400 OUTSTR(SNAME&CRLF);
15500 IF SNAME="" THEN DONE;
15600 FOR I←19 STEP 1 UNTIL 125 DO BEGIN
15700 IF LIST[I]=CVSIX(SNAME) THEN DONE; END;
15800 STX←I*74;
15900 OUTSTR("I="&CVS(I)&" SNAME="&CVXSTR(LIST[I])&CRLF);
16000 RL←0;
16100
16200
16300 WHILE EOFA=0 DO BEGIN "LISTREAD"
16400 HINDEX←21; HCOUNT←HINCNT←0;
16500 FILEI←SCAN(FILLST,1,J);
16600 IF FILEI="" THEN DONE;
16700
16800 CLOSE(CHAN4);
16900 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
17000 LOOKUP(CHAN4,FILEI,0);
17100 IF EOF≠0 THEN DONE;
17200 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
17300 SEGTOT←(LFILE[0]*6)%N;
17400 OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
17500 ARRYIN(CHAN4,INDATA[0],SEGTOT*4);
17600 CLOSE(CHAN4);
17700 BPT←POINT(6,INDATA[0],-1);
17800 ZZ: HINDEX←21; HCOUNT←HINCNT←0;
17900
18000 FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
18100 READ1←HEADER;
18200 J←CVSIX(READ1);
18300 FOR I←0 STEP 1 UNTIL 63 DO BEGIN IF PHLIST[I]=0 THEN BEGIN
18400 OUTSTR("Hint not identified for segment = "&READ1&" " &CVS(SEGC)&CRLF);DONE END;
18500 IF PHLIST[I]=J THEN BEGIN HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
18600 END;
18700
18800 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
18900 ZZZZ: SIG(P);
19000 ZZZ: END;
19100
19200 OUTSTR(CVS(HINCNT)&" hints . ");
19300 IF RL=0 THEN RL←1 ELSE BEGIN RL←0; OUTSTR(CRLF); END;
19400 IF EOFA≠0 THEN DONE;
19500 END "LISTREAD";
19600
19700 UPDATE;
19800
19900 TABOUT;
20000 OUTSTR("Tables saved"&CRLF);
20100
20200 END "RIPPLE";
20300
20400 END "SAY";